home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 02 - 1986 / 02.09 Sep 86.sit / 02.09 Sep 86 / basic source / Random File Utility next >
Encoding:
Text File  |  1986-07-25  |  6.4 KB  |  239 lines  |  [TEXT/MSBB]
  1. ' Professor Mac's Random Access Utility
  2. ' ©MacTutor 1986
  3. ' By Dave Kelly
  4.  
  5. OPTION BASE 1
  6. DEFINT a-z
  7. WINDOW 1,"",(2,25)-(510,335),3
  8. GOSUB WindowHeader
  9. Recordnumber=1
  10.  
  11. MENU 1,0,1,"File"
  12. MENU 1,1,1,"Open"
  13. MENU 1,2,0,"Close"
  14. MENU 1,3,0,"Edit"
  15. MENU 1,4,1,"Quit"
  16. MENU 3,0,0,""
  17. MENU 4,0,0,""
  18. MENU 5,0,0,""
  19. False=0: True= NOT False
  20. Fileopen = False
  21.  
  22. ON MENU GOSUB MenuEvent
  23. MENU ON
  24.  
  25. WaitForEvent: GOTO WaitForEvent
  26.  
  27. MenuEvent:
  28.     MenuNumber = MENU(0)
  29.     MenuItem = MENU(1):MENU
  30.     ON MenuNumber GOSUB Filemenu,Editmenu,Convertmenu
  31. RETURN
  32.  
  33. Filemenu:
  34.     ON MenuItem GOSUB OpenFile,CloseFile,FindRecord,Quititem
  35. RETURN
  36.     
  37. Editmenu:
  38. RETURN
  39.  
  40. WindowHeader:
  41.     TEXTFONT(2):TEXTSIZE(14):TEXTFACE(1)
  42.     LOCATE 1,15:PRINT"Random Access Utility"
  43.     TEXTSIZE(12):TEXTFACE(0)
  44. RETURN
  45.  
  46. Quititem:
  47.     IF Fileopen = True THEN GOSUB CloseFile
  48.     MENU RESET
  49.     WINDOW CLOSE 1
  50.     END
  51.  
  52. OpenFile:
  53.     Filename$=FILES$(1)
  54.     IF Filename$="" THEN GOSUB WindowHeader: RETURN
  55.     LOCATE 4,1:PRINT"  Enter the length of your Random Access File:"
  56.     GOSUB WindowHeader
  57.     EDIT FIELD 1,"128",(300,48)-(350,63),1,1
  58.     BUTTON 1,1,"OK",(315,130)-(365,180)
  59.     GOSUB Loop
  60.     Recordlength=VAL(EDIT$(1))
  61.     IF Recordlength >32767 OR Recordlength <=0 THEN GOTO OpenFile
  62.     BUTTON CLOSE 1
  63.     EDIT FIELD CLOSE 1:CLS
  64.     OPEN Filename$ AS #1 LEN=Recordlength
  65.     FIELD #1,Recordlength AS Random$
  66.  
  67. Setup:
  68.     GOSUB WindowHeader
  69.     Fileopen=True
  70.     MENU 1,1,0
  71.     MENU 1,2,1
  72.     MENU 1,3,1
  73.     RETURN
  74.  
  75. CloseFile:
  76.     Fileopen=False
  77.     MENU 1,1,1
  78.     MENU 1,2,0
  79.     MENU 1,3,0
  80.     CLOSE #1
  81.     IF MenuItem <>4 THEN GOSUB WindowHeader
  82.     RETURN
  83.     
  84. GetRecord:
  85.     IF Recordnumber=0 THEN PRINT "Record # 0 does not exist":RETURN
  86.         GET #1,Recordnumber
  87.         R$=Random$
  88. RETURN
  89.  
  90. StoreRecord:
  91.         LSET Random$=R$
  92.         PUT #1,Recordnumber
  93. RETURN
  94.  
  95. FindRecord:
  96.     CLS
  97.     LOCATE 4,1:PRINT"Enter Record Number to find:"
  98.     EDIT FIELD 1,STR$(Recordnumber),(200,48)-(250,63),1,1
  99.     BUTTON 1,1,"OK",(315,130)-(365,180)
  100.     GOSUB Loop
  101.     Recordnumber=VAL(EDIT$(1))
  102.     LOCATE 5,1
  103.     IF Recordnumber<1 OR Recordnumber > 16777215# THEN PRINT "Number out of range":BEEP:FOR i=1 TO 100:NEXT:GOTO FindRecord
  104.     GOSUB GetRecord
  105.     EDIT FIELD CLOSE 1
  106. EditRecord:
  107.     MENU ON
  108.     CLS:GOSUB WindowHeader
  109.     BUTTON CLOSE 1
  110.     GOSUB DecodeASCII
  111.     PRINT "Current Record is #";Recordnumber
  112.     LOCATE 17,1:PRINT "Conversion string:"
  113.     TEXTFONT(4)
  114.     EDIT FIELD 3,"",(10,280)-(90,295),2,1
  115.     EDIT FIELD 2,ASCII$,(10,130)-(485,250),1,1
  116.     EDIT FIELD 1,R$,(10,40)-(485,125),2,1
  117.     TEXTFONT(2)
  118.     BUTTON 1,1,"OK",(450,255)-(500,305)
  119.     BUTTON 2,1,"Write record after Edit",(275,22)-(450,37),3:b2=False
  120.     MENU 3,0,1,"Convert"
  121.     MENU 3,1,1,"CVI(string) Convert (2-bytes)"  'Convert 2-byte string
  122.     MENU 3,2,1,"CVS(string) Convert (4-bytes)" 'Convert 4-byte string
  123.     MENU 3,3,1,"CVD(string) Convert (8-bytes)" 'Convert 8-byte string
  124.     MENU 3,4,1,"MKI$(integer) Convert" 'Convert integer
  125.     MENU 3,5,1,"MKS$(single-precision) Convert" 'Convert single-precision
  126.     MENU 3,6,1,"MKD$(double-precision) Convert" 'Convert double-precision
  127.     i=1
  128.     EditLoop:
  129.         d=DIALOG(0)
  130.         IF d=1 THEN buttonpushed=DIALOG(1):IF buttonpushed=1 THEN EditDone ELSE GOSUB Switch
  131.         IF d=2 THEN i=DIALOG(2)
  132.         IF d=6 AND i=1 THEN EditDone
  133.         IF d=7 THEN i=(i MOD 2)+1:EDIT FIELD i
  134.     GOTO EditLoop
  135. EditDone:
  136.     R$=EDIT$(1)
  137.     IF i=2 THEN ASCII$=EDIT$(2): GOSUB EncodeASCII
  138.     IF b2 = True THEN GOSUB StoreRecord
  139.     EDIT FIELD CLOSE 1
  140.     EDIT FIELD CLOSE 2
  141.     EDIT FIELD CLOSE 3
  142.     BUTTON CLOSE 1:BUTTON CLOSE 2
  143.     MENU 3,0,0,""
  144.     CLS:GOSUB WindowHeader
  145.     RETURN
  146.  
  147. Convertmenu:
  148.     x#=FRE(0)
  149.     MENU OFF:TEXTFONT(4)
  150.     Convert$=EDIT$(3)
  151.     LOCATE 17,18:PRINT STRING$(35," "):LOCATE 18,18:PRINT STRING$(35," "):LOCATE 17,18
  152.     ON MenuItem GOSUB CVIconvert,CVSconvert,CVDconvert,MKIconvert,MKSconvert,MKDconvert
  153.     MENU ON:TEXTFONT(2)
  154.     RETURN
  155.     
  156. CVIconvert:
  157.     IF LEN(Convert$)<>2 THEN PRINT"Can't convert";LEN(Convert$);"bytes.":RETURN
  158.     IntNumber%=CVI(Convert$)
  159.     PRINT "CVI(";CHR$(34);Convert$;CHR$(34);")=";IntNumber%
  160. RETURN
  161.  
  162. CVSconvert:
  163.     IF LEN(Convert$)<>4 THEN PRINT"Can't convert";LEN(Convert$);"bytes.":RETURN
  164.     SingleNumber!=CVS(Convert$)
  165.     PRINT "CVS(";CHR$(34);Convert$;CHR$(34);")=";SingleNumber!
  166. RETURN
  167.  
  168. CVDconvert:
  169.     IF LEN(Convert$)<>8 THEN PRINT"Can't convert";LEN(Convert$);"bytes.":RETURN
  170.     DoubleNumber#=CVD(Convert$)
  171.     PRINT "CVD(";Convert$;")=";DoubleNumber#
  172. RETURN
  173.  
  174. MKIconvert:
  175.     IF VAL(Convert$)<-32767 OR VAL(Convert$)>32767 THEN PRINT "Number too big!":RETURN
  176.     IntNumber%=VAL(Convert$)
  177.     NewConvert$=MKI$(IntNumber%)
  178.     EDIT FIELD 3,NewConvert$,(10,280)-(90,295)
  179.     PRINT "MKI$(";Convert$;")= ASCII:";
  180.     PRINT USING " ###";ASC(MID$(NewConvert$,1,1)),ASC(MID$(NewConvert$,2,1))
  181. RETURN
  182.  
  183. MKSconvert:
  184.     IF VAL(Convert$)<-1.18E-38 OR VAL(Convert$)>3.3999E+38 THEN PRINT "Number too big!":RETURN
  185.     SingleNumber!=VAL(Convert$)
  186.     NewConvert$=MKS$(SingleNumber!)
  187.     EDIT FIELD 3,NewConvert$,(10,280)-(90,295)
  188.     PRINT "MKS$(";Convert$;")= ASCII:";
  189.     PRINT USING " ###";ASC(MID$(NewConvert$,1,1)),ASC(MID$(NewConvert$,2,1));
  190.     PRINT USING " ###";ASC(MID$(NewConvert$,3,1)),ASC(MID$(NewConvert$,4,1))
  191. RETURN
  192.  
  193. MKDconvert:
  194.     IF VAL(Convert$)<-2.23D-308 OR VAL(Convert$)>1.789999D+308 THEN PRINT "Number too big!":RETURN
  195.     DoubleNumber#=VAL(Convert$)
  196.     NewConvert$=MKD$(DoubleNumber#)
  197.     EDIT FIELD 3,NewConvert$,(10,280)-(90,295)
  198.     PRINT "MKD$(x)= ASCII:";
  199.     PRINT USING " ###";ASC(MID$(NewConvert$,1,1)),ASC(MID$(NewConvert$,2,1));
  200.     PRINT USING " ###";ASC(MID$(NewConvert$,3,1)),ASC(MID$(NewConvert$,4,1))
  201.     LOCATE 18,33
  202.     PRINT USING " ###";ASC(MID$(NewConvert$,5,1)),ASC(MID$(NewConvert$,6,1));
  203.     PRINT USING " ###";ASC(MID$(NewConvert$,7,1)),ASC(MID$(NewConvert$,8,1))
  204. RETURN
  205.  
  206. Switch:
  207.     b2=NOT b2
  208.     IF b2=True THEN BUTTON 2,2 ELSE BUTTON 2,1
  209.     RETURN
  210.     
  211. Loop:
  212.     d=DIALOG(0)
  213.     IF d=1 THEN Done
  214.     IF d=6 THEN Done
  215.     GOTO Loop
  216. Done:
  217. RETURN
  218.  
  219. DecodeASCII:
  220.     ASCII$=""
  221.     FOR i=1 TO Recordlength
  222.         ASCIInum$=STR$(ASC(MID$(R$,i,1)))+","
  223.         IF LEN(ASCIInum$)=2 THEN ASCIInum$=ASCIInum$
  224.         IF LEN(ASCIInum$)=3 THEN ASCIInum$=ASCIInum$
  225.         ASCII$=ASCII$+ASCIInum$
  226.     NEXT i
  227.     RETURN
  228.     
  229. EncodeASCII:
  230.     R$="":commaposition=1
  231.     FOR i=1 TO Recordlength
  232.         commaplace=INSTR(commaposition,ASCII$,",")
  233.         ASCIInum$=MID$(ASCII$,commaposition,commaplace-1)
  234.         commaposition=commaplace+1
  235.         R$=R$+CHR$(VAL(ASCIInum$))
  236.     NEXT i
  237.     RETURN
  238.     
  239.